unit UXMLReader;

interface

uses Classes, SysUtils;

type
  TXMLNodeInfo = class
  private
    { Private declarations }
    FAttributes : TStringList;
    FSubNodes: TStringList;
    FNameSpace: string;
    FNodeName: string;
    FValue: string;
    function GetAttributeByIndex(Index: Integer): string;
    function GetAttributeCount: Integer;
    function GetAttributes(Name: string): string;
    function GetChildren(Name: string): TXMLNodeInfo;
    function GetChildrenByIndex(Index: Integer): TXMLNodeInfo;
    function GetChildrenCount: Integer;
    procedure SetAttributeByIndex(Index: Integer; const Value: string);
    procedure SetAttributes(Name: string; const Value: string);
    procedure SetChildren(Name: string; const Value: TXMLNodeInfo);
    procedure SetChildrenByIndex(Index: Integer;
      const Value: TXMLNodeInfo);
    procedure SetNameSpace(const Value: string);
    procedure SetNodeName(const Value: string);
    procedure SetValue(const Value: string);
    procedure SetXML(const Value: string);
    function GetAttributeName(Index: Integer): string;
    function GetChildName(Index: Integer): string;
    function GetXML: string;
  public
    { Public declarations }
    constructor Create;
    destructor Destroy; override;
    function ReadNode(P: PChar): PChar;
    procedure LoadXMLFile(Filename: string);
    property AttributeName[Index: Integer]: string read GetAttributeName;
    property Attributes[Name: string]: string read GetAttributes write SetAttributes;
    property AttributeByIndex[Index: Integer]: string read GetAttributeByIndex write SetAttributeByIndex;
    property ChildName[Index: Integer]: string read GetChildName;
    property Children[Name: string]: TXMLNodeInfo read GetChildren write SetChildren;
    property ChildrenByIndex[Index: Integer]: TXMLNodeInfo read GetChildrenByIndex write SetChildrenByIndex;
  published
    property NodeName: string read FNodeName write SetNodeName;
    property NameSpace: string read FNameSpace write SetNameSpace;
    property AttributeCount: Integer read GetAttributeCount;
    property ChildrenCount: Integer read GetChildrenCount;
    property Value: string read FValue write SetValue;
    property XML: string read GetXML write SetXML;
  end;

implementation

{ TXMLNodeInfo }

constructor TXMLNodeInfo.Create;
begin
  FAttributes := TStringList.Create;
  FSubNodes := TStringList.Create;
end;

destructor TXMLNodeInfo.Destroy;
var
  i: Integer;
begin
  for i:= 0 to FSubNodes.Count - 1 do
    FSubNodes.Objects[i].Free;
  FSubNodes.Free;
  FAttributes.Free;
  inherited;
end;

function TXMLNodeInfo.GetAttributeByIndex(Index: Integer): string;
begin
  Result:= FAttributes.ValueFromIndex[Index];
end;

function TXMLNodeInfo.GetAttributeCount: Integer;
begin
  Result:= FAttributes.Count;
end;

function TXMLNodeInfo.GetAttributeName(Index: Integer): string;
begin
  Result:= FAttributes.Names[Index]
end;

function TXMLNodeInfo.GetAttributes(Name: string): string;
begin
  Result:= FAttributes.Values[Name];
end;

function TXMLNodeInfo.GetChildName(Index: Integer): string;
begin
  Result:= FSubNodes[Index];
end;

function TXMLNodeInfo.GetChildren(Name: string): TXMLNodeInfo;
begin
  Result:= TXMLNodeInfo(FSubNodes.Objects[FSubNodes.IndexOf(Name)]);
end;

function TXMLNodeInfo.GetChildrenByIndex(Index: Integer): TXMLNodeInfo;
begin
  Result:= TXMLNodeInfo(FSubNodes.Objects[Index]);
end;

function TXMLNodeInfo.GetChildrenCount: Integer;
begin
  Result:= FSubNodes.Count;
end;

function TXMLNodeInfo.GetXML: string;
var
  i: Integer;
  AttrStr: string;
begin
  AttrStr:= '';
  for i:= 0 to FAttributes.Count - 1 do
    AttrStr:= AttrStr + ' ' + FAttributes.Names[i] + '="' + FAttributes.ValueFromIndex[i] + '"';
  if(Value = '')and(ChildrenCount = 0)then
    Result:= '<' + NameSpace + ':' + NodeName + AttrStr + ' />'
  else begin
    Result:= '<' + NameSpace + ':' + NodeName + AttrStr + '>';
    for i:= 0 to FSubNodes.Count - 1 do
      Result:= Result + #13#10 + TXMLNodeInfo(FSubNodes.Objects[i]).XML;
    Result:= '</' + NameSpace + ':' + NodeName + '>';
  end;
end;

procedure TXMLNodeInfo.LoadXMLFile(Filename: string);
var
  F: TextFile;
  S, SV: string;
begin
  AssignFile(F, Filename);
  Reset(F);
  SV:= '';
  while not Eof(F) do begin
    ReadLn(F, S);
    SV:= SV + S;
  end;
  CloseFile(F);
  XML:= SV;
end;

function TXMLNodeInfo.ReadNode(P: PChar): PChar;
var
  IsName, IsValue, IsAttr, IsEnd: Boolean;
  N, S: string;
  newChild: TXMLNodeInfo;

  function GetQuoteValue(): string;
  var
    ch: Char;
  begin
    ch:= P[0];
    Inc(P);
    Result:= '';
    repeat
      Result:= Result + P[0];
      Inc(P);
    until(P = nil)or(P[0] = ch);
  end;

  procedure SaveAttr(AttrName, AttrValue: string);
  begin
    FAttributes.Add(N + '=' + S);
    S:= '';
    IsAttr:= False;
  end;
begin
  while(P[0] <> '<')and(P <> nil)do Inc(P);
  Inc(P);
  IsName:= True;
  IsValue:= False;
  IsEnd:= False;
  IsAttr:= False;
  while P <> nil do begin
    case P[0] of
    '<': begin
        if S <> '' then begin Value:= S; IsValue:= False; S:= ''; end;
        if P[1] <> '/' then begin
          newChild:= TXMLNodeInfo.Create;
          P:= newChild.ReadNode(P);
          FSubNodes.AddObject(newChild.NodeName, newChild);
          Continue;
        end;
      end;
    ' ': if IsName then begin           //
        NodeName:= S; S:= ''; IsName:= False;
      end else if IsAttr then SaveAttr(N, S);
    '=': begin
        N:= S; S:= ''; IsAttr:= True;
      end;
    #13, #10, #9: begin Inc(P); Continue; end;
    '''', '"': S:= S + GetQuoteValue;
    '/': if P[1] = '/' then S:= S + '/'
      else IsEnd:= True;
    '>': begin
        if IsName then begin NodeName:= S; S:= ''; IsName:= False; end;
        if IsAttr then SaveAttr(N, S);
        if IsEnd then begin Inc(P); Result:= P; Exit; end
        else IsValue:= True;
        S:= '';
      end;
    else S:= S + P[0];
    end;
    Inc(P);
  end;
  Result:= P;
end;

procedure TXMLNodeInfo.SetAttributeByIndex(Index: Integer;
  const Value: string);
begin
  if Index >= AttributeCount then Exit;
  FAttributes.ValueFromIndex[Index]:= Value;
end;

procedure TXMLNodeInfo.SetAttributes(Name: string; const Value: string);
begin
  FAttributes.Values[Name]:= Value;
end;

procedure TXMLNodeInfo.SetChildren(Name: string;
  const Value: TXMLNodeInfo);
var
  Idx: Integer;
begin
  Idx:= FSubNodes.IndexOf(Name);
  if Idx < 0 then raise Exception.Create('Can not find a node with ' + Name);
  if Assigned(FSubNodes.Objects[Idx]) then FSubNodes.Objects[Idx].Free;
  FSubNodes.Objects[Idx]:= Value;
end;

procedure TXMLNodeInfo.SetChildrenByIndex(Index: Integer;
  const Value: TXMLNodeInfo);
begin
  if Index >= FSubNodes.Count then raise Exception.Create('Index is overflow.');
  FSubNodes.Objects[Index]:= Value;
end;

procedure TXMLNodeInfo.SetNameSpace(const Value: string);
begin
  FNameSpace := Value;
end;

procedure TXMLNodeInfo.SetNodeName(const Value: string);
begin
  FNodeName := Value;
end;

procedure TXMLNodeInfo.SetValue(const Value: string);
begin
  FValue := Value;
end;

procedure TXMLNodeInfo.SetXML(const Value: string);
var
  P: PChar;
begin
  P := PChar(Value);
  ReadNode(P);
end;

end.

